Proyecto - Contingencias de Vida II
Librerías e importaciones
Factor de degradación para estados CAR
La metodología original empezaba a dar problemas con probabilidades negativas a partir de una edad aproximada de 95 años, por lo que se decidió implementar un factor de reducción desde los 90 años para primero, complementar la probabilidad creciente de muerte y además poder arreglar el problema de probabilidades negativas.
Mejora de mortalidades en el tiempo y mejora de transiciones de empeoramiento
Diseño del producto
Pago de primas: anual Esto se justifica con las probabilidades de transición de un año Temporalidad del seguro: vitalicio Es un seguro LTC, por lo que esperamos a que el asegurado tenga varios estados antes de morir. Si no fuera vitalicio, dejaríamos a medias a un asegurado. Temporalidad de pago de primas: hasta entrar en los estados severe/profound
Inflación: 3% Caso pesimista: 8% Caso optimista: -1%
Tasa de interés: 5% Caso pesimista: 3% Caso optimista: 6.5%
calculo_acumulado <- function(x, tables){
# Por si acaso, estados termina en 000001 porque multiplicamos todas las transiciones
t1 <- tables$Able %>% select(-x)
t2 <- tables$Mild %>% select(-x)
t3 <- tables$Moderate %>% select(-x)
t4 <- tables$Severe %>% select(-x)
t5 <- tables$Profound %>% select(-x)
estados <- as.numeric(t1[1,])
suma <- estados
for(i in 2:(120-x)){
matriz_t <- rbind(t1[i,], t2[i,], t3[i,], t4[i,], t5[i,], c(0,0,0,0,0,1))
matriz_t <- as.matrix(matriz_t)
estados <- estados %*% matriz_t
suma <- suma + estados
}
return(suma)
}## Able Mild Moderate Severe Profound Dead
## [1,] 47.37181 6.189344 3.146311 2.592936 3.691732 37.00786
edad20sin_m <- lapply(Males, function(x) as.data.frame(x[21:120,]))
calculo_acumulado(20, edad20sin_m)## Able Mild Moderate Severe Profound Dead
## [1,] 42.42809 5.49957 2.619793 1.85696 2.063781 45.5318
Hay una clara diferencia entre mejorías de mortalidades
Cálculo de valores presentes
calculo_vp <- function(x, tables, interes, inflacion){
# Por si acaso, termina en 000001 porque estamos multiplicando todas las transiciones
v <- (1+inflacion)/(1+interes)
t1 <- tables$Able %>% select(-x)
t2 <- tables$Mild %>% select(-x)
t3 <- tables$Moderate %>% select(-x)
t4 <- tables$Severe %>% select(-x)
t5 <- tables$Profound %>% select(-x)
estados <- as.numeric(t1[1,])
suma <- estados
seguro <- 0
for(i in 2:(120-x)){
matriz_t <- rbind(t1[i,], t2[i,], t3[i,], t4[i,], t5[i,], c(0,0,0,0,0,1))
matriz_t <- as.matrix(matriz_t)
temp <- estados %*% matriz_t
# Personalizable según el tipo de desembolso/prima
seguro <- seguro + (temp[6]- estados[6])*v^i
estados <- temp
suma <- suma + estados*v^(i-1)
}
suma[6] <- seguro
return(suma)
}prueba <- calculo_vp(20, edad20, 0.07, 0.03)
# Seguro de vida normal, 100 millones
(prueba[6]*100e6 )/(12*prueba[1])## [1] 40566.81
# Seguro de vida con anualidades en caso de Severe o Profound, pagando Mild y Moderate
(prueba[6]*100e6 + 12*(1.5e6*prueba[4] + 3e6*prueba[5]) )/(12*(prueba[1]+prueba[2]+prueba[3]))## [1] 131250.8
# Seguro de vida con anualidades pagando 0.25e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.25e6*prueba[2] +
0.5e6*prueba[3] +
0.75e6*prueba[4] +
1e6*prueba[5]))/(12*prueba[1])## [1] 111972.8
# Seguro de vida con anualidades pagando 0.5e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.5e6*prueba[2] +
1e6*prueba[3] +
1.5e6*prueba[4] +
2e6*prueba[5]))/(12*prueba[1])## [1] 183378.8
Modelo estocástico
Generación del portafolio
set.seed(70707)
portfolio <- data.frame(edad = round(runif(5000, 19.5, 70.5)),
sexo = round(runif(5000, 1, 2))) %>%
arrange(., edad, sexo) %>%
mutate(id = dense_rank(paste(edad, sexo)))
descripcion <- portfolio %>% count(edad, sexo)Proyección de primas
Esto es extra, no se piden.
## user system elapsed
## 0.00 0.11 0.92
Preparación para modelar estocásticamente
Variables globales
interes <- 0.07
inflacion <- 0.03
edades <- portfolio$edad
rango <- 120 - min(edades)
v <- (1 + inflacion) / (1 + interes)
v_power <- v^(0:rango)
mujeres <- sum(portfolio$sexo == 2)
hombres <- sum(portfolio$sexo == 1)
sexos <- portfolio$sexo == 1
variables <- c("lista",
"portfolio",
"sexos",
"hombres",
"mujeres",
"rango",
"v_power",
"proyeccion") Resumen estocástico
Esperanza
## user system elapsed
## 0.27 0.00 0.53
Percentil
## user system elapsed
## 0.38 0.00 0.92